perm filename AREAS.SAI[PUB,TES] blob sn#195730 filedate 1976-01-28 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00014 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	BEGOF("AREAS")
C00004 00003	PUBLIC SIMPLE PROCEDURE AREAS! $"#
C00005 00004	PUBLIC RECURSIVE PROCEDURE ASSUREAREA $"#
C00006 00005	PUBLIC PROCEDURE BURPAREAS(BOOLEAN VERBOSE) $"#
C00013 00006	PUBLIC RECURSIVE PROCEDURE CLOSEAREA(INTEGER ITSIX BOOLEAN DISDECLAREIT) $"#
C00015 00007	PUBLIC RECURSIVE PROCEDURE DAREA(BOOLEAN TITAREA) $"#
C00018 00008	PUBLIC RECURSIVE PROCEDURE DCLOSE $"#
C00019 00009	PUBLIC SIMPLE PROCEDURE GROWAA(INTEGER HOWMUCH) $"#
C00020 00010	PUBLIC SIMPLE PROCEDURE MAKEAREA(INTEGER ITSIX) $"#
C00022 00011	PUBLIC SIMPLE PROCEDURE PLACE(INTEGER NEWAREAIX) $"#
C00025 00012	PUBLIC RECURSIVE PROCEDURE OPENAREA(INTEGER ITSIX) $"#
C00028 00013	PUBLIC SIMPLE PROCEDURE REMNULLS $"#
C00029 00014	FINISHED
C00030 ENDMK
C⊗;
BEGOF("AREAS")

COMMENT

An area declaration results in a declaration record of type AREATYPE
on the ISTK stack.  Each instantiation of an area on some page
results in a distinct instantiation record allocated as a new dynamic
array.

An instantiated area proceeds through three or four stages of status:
made but unopened, opened, closed, [and disdeclared].  PLACE makes
unopened areas, PLACELINE forces the area to open, filling it up or
closing the page causes the area to close, and the END of the block
in which it is declared causes it to be (closed and) dis-declared.

;

PROCEDURES
PUBLIC SIMPLE PROCEDURE AREAS! ;$"#
BEGIN "AREAS!"
AVAILREC[0] ← NULLAREAS ← 0 ;
SYMTEXT ← SYMNUM("TEXT") ;
END "AREAS!" ;
PUBLIC RECURSIVE PROCEDURE ASSUREAREA ;$"#
	IF AREAIDA = 0 OR STATUS NEQ 1 THEN OPENAREA(IF AREAIXM THEN AREAIXM ELSE IXTEXT) ;
PUBLIC PROCEDURE BURPAREAS(BOOLEAN VERBOSE) ;$"#
BEGIN TES 8/19/74 CALLED BY DBURP ;
INTEGER NAREAS ; INTEGER ARRAY FOUND[1:100], THISAREA[0:ONE], AA[0:ONE,0:ONE] ;
PROCEDURE BURPAREADECL(INTEGER ILOC, IDA) ;
	BEGIN
	INTEGER I ;
	OUTSTR(
	(IF TEXTAR(ILOC) THEN NULL ELSE "TITLE ") &
	"AREA " & SYM[LDB(BIXNUM(ILOC))] &
	" LINES " & CVS(LINE1(ILOC)) & " TO " & CVS(LINE1(ILOC)+LINECT(ILOC)-1) &
	" CHARS " & CVS(CHAR1(ILOC)) & " TO " & CVS(CHAR1(ILOC)+CHARCT(ILOC)-1) &
	(IF (I←COLCT(ILOC)) NEQ 1 THEN " IN " & CVS(I) & " COLUMNS " &
	    CVS(COLWID(ILOC)) & " WIDE" ELSE NULL) &
	CRLF & "    " &
	(IF DISD(ILOC) THEN "DISDECLARED " ELSE "DECLARED ") &
	(IF FULHIGH(ILOC) THEN "FULL HEIGHT " ELSE NULL) &
	(IF FULWIDE(ILOC) THEN "FULL WIDTH " ELSE NULL) &
	"AT " & CVOS(ISTKIDA+ILOC) &
	(IF (I ← OLD!ACTIVE(ILOC)) AND I NEQ IDA THEN " RECORD "&CVOS(I) ELSE NULL) &
	(IF (I ← NEW!ACTIVE(ILOC)) THEN "NEWPAGE RECORD " & CVOS(I) ELSE NULL) &
	(IF (I←MARGINS(ILOC)) THEN " MARGINS " & CVS(LMARGX(I)) & SP & CVS(RMARGX(I)) ELSE NULL) &
	(IF XCRIBL THEN " FONTS " & PICKFONT(TFONT(ILOC))[3 TO ∞] &
		 "*" & PICKFONT(OFONT(ILOC))[3 TO ∞] ELSE NULL) &
	(IF FULSTR(SSTK[FOOTSTR(ILOC)]) THEN " FOOTNOTES PENDING" ELSE NULL) &
	CRLF) ;
	END "BURPAREADECL" ;
PROCEDURE BURPAREARECORD(INTEGER ARIDA; BOOLEAN INFRAME) ;
	BEGIN
	INTEGER COLS, LINES, I, J, X, Y ;
	INTEGER PCOL, PLINE, PPINE ;
	BOOLEAN SOME ;
	IDASSIGN(ARIDA, THISAREA) ;
	IDASSIGN(AAA, AA) ;
	IF (I←DEFA) THEN BEGIN FOUND[NAREAS←NAREAS+1]←I ; BURPAREADECL(I, ARIDA) END ;
	COLS ← ARRINFO(AA, 2)/2 ; LINES ← ARRINFO(AA,4) ;
	IF STATA=1 THEN  TES 8/26/74 IT IS OPEN ;
		IF AREAIDA=ARIDA THEN  COMMENT IT'S CURRENT ;
			BEGIN
			PCOL ← COL ; PLINE ← LINE ; PPINE ← PINE ;
			END
		ELSE	BEGIN
			PCOL ← COLA ;
			PLINE ← RH(AA[PCOL,0]) ;
			PPINE ← RH(AA[(COLS+COLS-1) MOD (2*COLS) +1, 0]) ;
			END ;
	IF STATA > 1 THEN
		OUTSTR("AREA ? LINES " & CVS(ULLA) & " TO " &
			CVS(ULLA+LINECA-1) & " CHARS " & CVS(RH(AA[1,0])) &
			" TO ? IN " & CVS(COLCA) & " COLUMNS" & CRLF) ;
	OUTSTR(TB &
	(IF NOT INFRAME THEN " NOT IN FRAME"
	 ELSE IF INA NEQ FRAMEIDA THEN " ** FRAME BACKLINK INCORRECT**"
	 ELSE NULL) &
	(CASE STATA OF (" UNOPENED", " OPENED", " CLOSED", " DIS-DECLARED")) &
	 " AT " & CVOS(ARIDA) &
	(IF AREAIDA=ARIDA THEN " (CURRENT)" ELSE NULL) &
	(IF XCRIBL THEN
		(IF XGENA THEN " XGENLINES = "&CVS(XGENA) ELSE NULL)&
		(IF OVERA THEN " OVEREST OF COLUMN 1 = "&CVS(OVERA) ELSE NULL)
	 ELSE NULL) &
	(IF STATA=1 THEN
	  " PLACED "&CVS(PLINE)&" LINES IN COLUMN "&
		CVS(IF PCOL>COLS THEN PCOL-COLS ELSE PCOL) &
		(IF PCOL>COLS THEN " FOOT" ELSE NULL) &
		(IF PCOL>COLS OR PPINE THEN " ("&CVS(PPINE)&" IN THE " &
		    (IF PCOL>COLS THEN "LEG)" ELSE "FOOT)")
		ELSE NULL)
	 ELSE NULL) &
	CRLF) ;
	IF VERBOSE THEN
		BEGIN
		OUTSTR(TB&"  LINE"&TB) ;
		FOR I←1 THRU COLS DO OUTSTR("     COLUMN  "&CVS(I)&TB) ;
		OUTSTR(CRLF & TB & TB) ;
		FOR I ← 1 THRU COLS DO OUTSTR("   CALF     FOOT"&TB) ;
		OUTSTR(CRLF) ;
		FOR J ← 1 THRU LINES DO
			BEGIN
			SOME ← FALSE ;
			FOR I ← 1 THRU 2*COLS DO IF AA[I,J] THEN BEGIN SOME←TRUE;DONE END ;
			IF SOME THEN
				BEGIN
				OUTSTR(TB & "    " & CVS(J) & TB) ;
				FOR I ← 1 THRU COLS DO
				    FOR Y←0,COLS DO
					OUTSTR(IF (X←AA[I+Y,J]) THEN ("     "&CVS(OWLS[X]))[∞-5 TO ∞]&TB ELSE TB) ;
				OUTSTR(CRLF) ;
				END ;
			END ;
		END ;
	END "BURPAREARECORD" ;
INTEGER A, I, THISIDA, AAIDA ; BOOLEAN DID ;
THISIDA ← WHATIS(THISAREA) ; AAIDA ← WHATIS(AA) ;
IF FRAMEIDA=0 THEN OUTSTR("BETWEEN PAGES"&CRLF)  TES 8/26/74 ;
ELSE	BEGIN
	A ← ARF ; NAREAS ← 0 ;
	WHILE A DO
		BEGIN COMMENT SEARCH THIS FRAME ;
		BURPAREARECORD(A, TRUE) ;
		A ← ARA ;
		END ;
	END ;
A ← NULLAREAS ;
WHILE A DO
	BEGIN COMMENT SEARCH NULL AREAS LIST (MADE BUT UNOPENED) ;
	BURPAREARECORD(A, FALSE) ;
	A ← RH(INA) ;
	END ;
A ← IHED ;
WHILE A > 1 DO
	BEGIN COMMENT SEARCH ISTK ;
	IF IXTYPE(A) = AREATYPE THEN
		BEGIN
		DID ← FALSE ;
		FOR I ← 1 THRU NAREAS DO IF FOUND[I]=A THEN
			BEGIN DID ← TRUE ; DONE END ;
		IF NOT DID THEN BURPAREADECL(A, 0) ;
		END ;
	A ← IXOLD(A) ;
	END ;
MAKEBE(THISIDA, THISAREA) ; MAKEBE(AAIDA, AA) ;
END "BURPAREAS" ;
PUBLIC RECURSIVE PROCEDURE CLOSEAREA(INTEGER ITSIX; BOOLEAN DISDECLAREIT) ;$"#
BEGIN "CLOSEAREA"
INTEGER SAVAR, C, WC, NC, CC, LEFC ; BOOLEAN NORESP ;
NORESP ← ITSIX < 0 ; ITSIX ← ABS(ITSIX) ;
IF DISDECLAREIT THEN OLMAX ← OLMAX - LINECT(ITSIX)*COLCT(ITSIX) ;
IF OPEN!ACTIVE(ITSIX) = 0 THEN	IF DISDECLAREIT THEN CLOSET(ITSIX, FALSE, TRUE)
				ELSE BEGIN END
ELSE BEGIN SAVAR←AREAIXM; PLACE(ITSIX); IF STATUS=0 THEN REMNULLS ; STATA ← STATUS←2;
	ULLA ← LINE1(ITSIX) ;  AA[1,0] ← LEFC ← CHAR1(ITSIX) ;
	IF (NC ← COLCT(ITSIX)) > 1 THEN
		BEGIN
		WC ← COLWID(ITSIX) ; CC ← CHARCT(ITSIX) ;
		FOR C ← 2 THRU NC DO AA[C,0] ← LEFC + ((C-1)*(CC-WC)) DIV (NC-1) ;
		END ;
	LINECA ← LINECT(ITSIX) ; COLCA ← NC ;
	IF  NOT NORESP THEN CLOSET(ITSIX, TRUE, DISDECLAREIT) ;
	IF DISDECLAREIT THEN BEGIN STATA ← STATUS←3 ; DEFA ← 0 END ;
	OPEN!ACTIVE(ITSIX) ← AREAIDA ← 0 ;
	IF SAVAR AND  NOT DISDECLAREIT AND SAVAR NEQ ITSIX THEN PLACE(SAVAR) ELSE BEGIN AREAIXM←0; STATUS←-1 END ;
	END ;
END "CLOSEAREA" ;
PUBLIC RECURSIVE PROCEDURE DAREA(BOOLEAN TITAREA) ;$"#
BEGIN
INTEGER I, IX, SYMB, TEMP, A, B ;
PRELOAD!WITH "LINE",  "TO",  "CHAR",  "TO",   "IN", "COLUMN", "COLUMN" ;
OWN STRING ARRAY PRE[1:7] ; STRING ARRAY PAR[1:7] ;
PRELOAD!WITH  NULL,   NULL,   NULL,   NULL,   NULL,   "WIDE",   "APART" ;
OWN STRING ARRAY POST[1:7] ;
DBREAK; DPASS ;
IF  NOT THISISID THEN BEGIN WARN("=","AREA must have name"); THISWD←"!DUMMY" END ;
SYMB ← SYMNUM(THISWD) ;
PASS ;
PARAMS(7, PRE, PAR, POST) ;
IF  NOT ON THEN RETURN ;
BIND(DECLARE(SYMB, AREATYPE), IX←PUSHI(AREAWDS,AREATYPE)) ;
IF FULHIGH(IX)←NULSTR(PAR[1]) THEN BEGIN A←1 ; B←FHIGH END comment assume LINE 1 TO <frame height> ;
ELSE BEGIN A ← CVD(PAR[1]) ;  B ← IF NULSTR(PAR[2]) THEN A ELSE CVD(PAR[2]) END ;
LINE1(IX) ← A MAX 1 ;  LINECT(IX) ← B-A+1 MAX 1 ;
IF FULWIDE(IX)← NULSTR(PAR[3]) THEN BEGIN A←1 ; B←FWIDE END
ELSE BEGIN A ← CVD(PAR[3]) ;  B ← IF NULSTR(PAR[4]) THEN A ELSE CVD(PAR[4]) END ;
CHAR1(IX) ← A MAX 1 ;  CHARCT(IX) ← B←B-A+1 MAX 1 ;
TEXTAR(IX) ← IF TITAREA THEN 0 ELSE 1 ;
IF NULSTR(PAR[5]) THEN A ← 1 comment Assume IN 1 COLUMNS <charct> WIDE ;
ELSE	BEGIN "COLUMNS"
	A ← CVD(PAR[5]) ; comment How many ;
	IF FULSTR(PAR[6]) THEN B ← CVD(PAR[6]) MIN  B DIV A
	ELSE B ← (B+( TEMP←IF FULSTR(PAR[7]) THEN CVD(PAR[7]) ELSE 5 )) DIV A - TEMP ;
	END "COLUMNS" ;
COLCT(IX) ← A MAX 1 ;  COLWID(IX) ← B MAX 1 ;
OLMAX ← OLMAX + A*LINECT(IX) ;
FOOTSTR(IX) ← PUSHS(1, NULL) ;
MARGINS(IX) ← FONTSIX(IX) ← 0 ; TES 11/15/73 ;
MILLSKIP(IX) ← MILLGSKIP(IX) ← 0 ; TES 11/7/74 ;
TFONT(IX) ← OFONT(IX) ← DEFAULTFONT ; TES 11/15/73 ;
END "DAREA" ;
PUBLIC RECURSIVE PROCEDURE DCLOSE ;$"#
BEGIN
DBREAK ; PASS ;
IF ON THEN
IF THISTYPE=AREATYPE THEN CLOSEAREA(IX,FALSE)
ELSE IF IX=IXPAGE THEN comment, * * * * * * * * * * * * * ;
ELSE WARN("=","CLOSE What? "&SOMEINPUT) ;
PASS ;
END "DCLOSE" ;
PUBLIC SIMPLE PROCEDURE GROWAA(INTEGER HOWMUCH) ;$"#
	BEGIN "GROWAA"  TES 11/6/74 ;
	AAA ← BIGGR2(AAA, HOWMUCH) ;
	IDASSIGN(AAA, AA) ;
	END "GROWAA" ;
PUBLIC SIMPLE PROCEDURE MAKEAREA(INTEGER ITSIX) ;$"#
BEGIN "MAKEAREA"
INTEGER C, L, CS, LS, NCH, OCH, C1, CC, FW, L1, LC, FH ;
C1 ← CHAR1(ITSIX) ; CC ← CHARCT(ITSIX) ;
FW ← IF FRAMEIDA THEN WIDEF ELSE FWIDE ;
L1 ← LINE1(ITSIX) ; LC ← LINECT(ITSIX) ;
FH ← IF FRAMEIDA THEN HIGHF ELSE FHIGH ;
IF FULWIDE(ITSIX) THEN
	BEGIN Comment Make frame width ;
	OCH ← CC ; CHARCT(ITSIX) ← NCH ← FW ;
	COLWID(ITSIX) ← (COLWID(ITSIX) * NCH)  DIV  OCH  ;
	END ;
IF FULHIGH(ITSIX) THEN LINECT(ITSIX) ← FH ;
L←OPEN!ACTIVE(ITSIX)←CREATE(0, AREC) ;
IF NULLAREAS THEN BEGIN IDASSIGN(AREAIDA←NULLAREAS,THISAREA) ; INA←LHRH(L,INA) END ;
IDASSIGN(AREAIDA ← L, THISAREA) ;
DEFA ← ITSIX ; STATA ← 0 ; INA ← LHRH(0, NULLAREAS) ; NULLAREAS ← AREAIDA ;
IDASSIGN(AAA←CREATE2(1, CS←COLCT(ITSIX)*2, 0, LS←LC+((LC DIV 2) MAX 8) ) , AA) ;
ZEROWORDS(CS*(LS+1), AA[1,0]) ;
COMMENT FOR C ← 1 THRU CS DO FOR L ← 0 THRU LS DO AA[C,L] ← 0 ;
END "MAKEAREA" ;
PUBLIC SIMPLE PROCEDURE PLACE(INTEGER NEWAREAIX) ;$"#
COMMENT If No Place Area, AREAIXM=0.  AREAIDA NEQ 0 if STATUS= 0 or 1 ;        
IF ON THEN
BEGIN "PLACE"
INTEGER FRM, ALLOW!FOR, MARGIX, FONTIX ;
IF IXTYPE(NEWAREAIX) NEQ AREATYPE THEN
	BEGIN WARN("=","PLACE in non-area"); NEWAREAIX←IXTEXT END;
IF AREAIXM THEN
	BEGIN TES 11/19/73 ;
	TFONT(AREAIXM) ← THISFONT ;
	OFONT(AREAIXM) ← OLDFONT ;
	END ;
IF AREAIDA AND STATUS=1 THEN
	BEGIN
	COLA ← COL ; AA[COL,0] ← LHRH(COVERED,LINE) ; AA[PAL,0]←LHRH(COVERED,PINE) ; STATA←STATUS ;
	XGENA ← XGENLINES; RKJ;
	OVERA ← OVEREST ; TES 11/15/73;
	IF AREAIXM=NEWAREAIX THEN RETURN
	ELSE IF COL>COLS THEN BEGIN WARN("=","Can't PLACE inside footnotes!") ; RETURN END ;
	END ;
IF XCRIBL AND AREAIXM NEQ NEWAREAIX THEN
	BEGIN INTEGER DUMMY ;TES 11/15/73 ;
	THISFONT ← TFONT(NEWAREAIX) ; OLDFONT ← OFONT(NEWAREAIX) ;
	IF (DUMMY←FNTFIL[THISFONT])>0 THEN MAKEBE(DUMMY, CW) ;
	END ;
AREAIXM←NEWAREAIX ;
IF (AREAIDA ← OPEN!ACTIVE(AREAIXM)) = 0 THEN MAKEAREA(AREAIXM)
ELSE BEGIN MAKEBE(AREAIDA, THISAREA) ;  IDASSIGN(AAA, AA) ; END ;
IF (MARGIX ← MARGINS(AREAIXM)) = 0 THEN BEGIN LMARG ← 0 ; RMARG ← COLWID(AREAIXM) END
ELSE BEGIN LMARG ← LMARGX(MARGIX) ; RMARG ← RMARGX(MARGIX) END ;
ALLOW!FOR ← 2 * COLWID(AREAIXM) ;
IF ALLOW!FOR > LENGTH(OWL) THEN OWL ← OWL & SP & SPS(ALLOW!FOR - LENGTH(OWL)) ;
COLS ← COLCT(AREAIXM) ;  LINES ← LINECT(AREAIXM) ; STATUS ← STATA ;
IF STATUS=1 THEN
	BEGIN "IT'S OPEN"
	COL ← COLA ; PAL ← (COL+COLS-1) MOD (2*COLS) + 1 ; COMMENT, Leg SWAP Foot;
	LINE ← AA[COL,0] ; COVERED ← LH(LINE) ; LINE ← RH(LINE) ; PINE ← RH(AA[PAL,0]) ;
	XGENLINES ← XGENA; RKJ;
	OVEREST ← OVERA ; TES 11/15/73 ;
	END "IT'S OPEN"
ELSE COL←PAL←LINE←COVERED←PINE←XGENLINES←OVEREST←0 ; RKJ ADDED XGENLINES;
	TES ADDED OVEREST 11/15/73;
END "PLACE" ;
PUBLIC RECURSIVE PROCEDURE OPENAREA(INTEGER ITSIX) ;$"#
BEGIN "OPENAREA"
INTEGER X, PREV, NEX, C1, CC, L1, LC ;
IF FRAMEIDA=0 THEN OPENPAGE ; PLACE(ITSIX) ; IF STATUS=1 THEN RETURN ; REMNULLS ;
C1 ← CHAR1(ITSIX) ; CC ← CHARCT(ITSIX) ;
L1 ← LINE1(ITSIX) ; LC ← LINECT(ITSIX) ;
IF C1+CC-1 > WIDEF THEN
	WARN(NULL,"AREA " & SYM[LDB(BIXNUM(ITSIX))] & " is wider than PAGE FRAME"&CRLF&
		"CHARS " & CVS(C1) & " TO " & CVS(C1+CC) &
		" exceeds " & CVS(WIDEF) & " WIDE") ;
IF L1+LC-1 > HIGHF THEN
	WARN(NULL,"AREA " & SYM[LDB(BIXNUM(ITSIX))] & " is higher than PAGE FRAME"&CRLF&
		"LINES " & CVS(L1) & " TO " & CVS(L1+LC) &
		" exceeds " & CVS(HIGHF) & " HIGH") ;
INA ← FRAMEIDA ;
PREV ← 0 ; NEX ← ARF ; X ← AREAIDA ; COMMENT KEEP AREAS SORTED BY LEFT EDGE ;
IF C1 > 1 THEN WHILE NEX DO
	BEGIN
	IDASSIGN(AREAIDA←NEX, THISAREA) ;
	IF DEFA THEN IF CHAR1(DEFA) GEQ C1 THEN DONE ELSE BEGIN END
	ELSE BEGIN IDASSIGN(AAA,AA) ; IF AA[1,0] GEQ C1 THEN DONE ; END ;
	PREV ← AREAIDA ; NEX ← ARA ;
	END ;
IF PREV THEN
	BEGIN TES AND DCS REVISED 9/24/73@SU, 10/25/73@PARC ;
	IDASSIGN(AREAIDA←PREV, THISAREA) ; TES ADDED THIS ;
	ARA ← X ;
	END
ELSE ARF ← X ;
IDASSIGN(AREAIDA←X, THISAREA) ;  ARA ← NEX ;
IDASSIGN(AAA, AA) ; TES 8/27/74 FIX BUG !!;
STATA ← STATUS←1 ; COL ← 1 ; PAL ← COLS + 1 ;
IF FINDTRAN(LDB(BIXNUM(ITSIX)), 4) THEN RESPOND(LLTHIS) ; comment BEFORE areaname ... ;
END "OPENAREA" ;
PUBLIC SIMPLE PROCEDURE REMNULLS ;$"#
BEGIN "REMNULLS"
INTEGER L, R, I ;
L ← LH(INA) ; R ← RH(INA) ;
IF L OR R THEN
	BEGIN
	I ← AREAIDA ;
	IF L THEN BEGIN IDASSIGN(AREAIDA←L,THISAREA); DPB(R, H2(INA)) ; END ELSE NULLAREAS ← R ;
	IF R THEN BEGIN IDASSIGN(AREAIDA←R,THISAREA); DPB(L, H1(INA)) ; END ;
	IDASSIGN(AREAIDA ← I, THISAREA) ;
	END
ELSE NULLAREAS ← 0 ;
END "REMNULLS" ;
FINISHED

ENDOF("AREAS")